home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MATH.SWG / 0038_Trapping 8087 Errors.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-02  |  4KB  |  126 lines
  1. {
  2. > I know that in pascal there is some way to create the Program
  3. > from crashing if the users does something wrong.  I need to know how to
  4. To prevent Type errors on input always use Strings and convert them
  5. afterwards using the VAL Procedure.
  6.  
  7. Try this to trap arithmetic errors.
  8. }
  9.  
  10. {$N+,G+}
  11. Unit op8087;
  12.  
  13. { The routines below duplicate two Op8087 routines For use in TPW, +
  14.   Exceptions8087 and Error8087.  These routines are helpful when +
  15.   doing Real math and you don't want to explicitly check For divide +
  16.   by zero, underflow, and overflow.  Need to use the compiler +
  17.   directives N+ and G+.  See OPro or 8087 documentation For a complete +
  18.   description of the 8087 status Word returned by Error8087.
  19.  
  20.   Do not embed Error8087 in a Write statement as the 8087 status Word +
  21.   will be cleared, and the result meaningless.
  22.  
  23.   Version 1.00 09/17/92
  24.  
  25.   Deven Hickingbotham, Tamarack Associates, 72365,46
  26.  
  27.   -----------------------------------------------------------------
  28.   Added infinity and NAN 'Constants' and created Unit December 1992
  29.   Kevin Whitefoot, Aasgaten 45, N-3060 Svelvik, Norway.
  30.  
  31.   After this Unit has initialized 8087 exceptions will be OFF and the NAN
  32.   and INF Variables set to NAN and INF respectively.  These Variables can be
  33.   used in comparisons or to indicate uninitialized Variables.  The Variables
  34.   are of Type extended but are compatible With singles and doubles too.  You
  35.   cannot assign the value in INF or NAN to a Real because the Real cannot
  36.   represent these values (if you do you will get error 105).
  37.   -----------------------------------------------------------------
  38.  
  39. }
  40.  
  41.  
  42. Interface
  43.  
  44. Procedure Exceptions8087(On : Boolean);
  45. Function  Error8087 : Word; {Assumes $G+, 287 or better  }
  46.  
  47. Function isdoublenan(r : double) : Boolean;
  48. Function issinglenan(r : single) : Boolean;
  49.  
  50. {These two Functions are used instead of direct comparisons With NANs as
  51. all numbers are = to NAN; very strange}
  52.  
  53. Const
  54.   nanpattern : Array [0..9] of Byte =
  55.     ($FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF);
  56.   { This is the bit pattern of an extended 'not a number'.  The +
  57.     Variable NAN is overlaid on this as we cannot create a NAN in a +
  58.     normal Constant declaration.}
  59. Var
  60.   nan : extended Absolute nanpattern;
  61.   { not a number'; this is convenient For uninitialized numbers, +
  62.     errors and so on, parsers can be designed to return this when +
  63.     the input is not a number so that the error remains visible even +
  64.     if the user or Program takes no corrective action}
  65.   inf : extended;
  66.   { The initialization of this routine deliberately executes a +
  67.     divide by zero so as to create and infinity and stores it here +
  68.     For general use.}
  69.  
  70.   singlenan : single;
  71.   doublenan : double;
  72.  
  73. Implementation
  74.  
  75. Function isdoublenan(r : double) : Boolean;
  76. Var
  77.   l1 : Array [0..1] of LongInt Absolute singlenan;
  78.   l2 : Array [0..1] of LongInt Absolute r;
  79. begin
  80.   isdoublenan := (l1[0] = l2[0]) and (l1[1] = l2[1]);
  81. end;
  82.  
  83. Function issinglenan(r : single) : Boolean;
  84. Var
  85.   l1 : LongInt Absolute singlenan;
  86.   l2 : LongInt Absolute r;
  87. begin
  88.   issinglenan := l1 = l2;
  89. end;
  90.  
  91. Procedure Exceptions8087(On : Boolean); Assembler;
  92. Var
  93.   CtrlWord : Word;
  94. Asm
  95.   MOV   AL, On
  96.   or    AL, AL
  97.   JZ    @ExceptionsOff
  98.  
  99.   MOV   CtrlWord, 0372H    { Unmask IM, ZM, OM }
  100.   JMP   #ExceptionsDone
  101.  
  102.  @ExceptionsOff:
  103.   FSTCW CtrlWord           { Get current control Word }
  104.   or    CtrlWord, 00FFh    { Mask all exceptions }
  105.  
  106.  @ExceptionsDone:
  107.   FLDCW CtrlWord           { Change 8087 control Word }
  108. end;
  109.  
  110.  
  111. Function Error8087 : Word; Assembler;   {Assumes $G+, 287 or better  }
  112. Asm
  113.   FSTSW AX        { Get current status Word  }
  114.   and   AX, 03Fh  { Just the exception indicators }
  115.   FCLEX           { Clear exception indicators  }
  116. end;
  117.  
  118. begin
  119.   Exceptions8087(False);
  120.   inf := 0; { Use a Variable not a Constant or the expression will be
  121.               resolved at compile time and the compiler will complain }
  122.   inf := 1 / inf;
  123.   singlenan := nan;
  124.   doublenan := nan;
  125. end.
  126.